home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1995 November / Macworld Nov ’95.toast / Developers / Selection ƒ 2.5 / baseControl < prev    next >
Encoding:
Text File  |  1994-11-06  |  4.0 KB  |  179 lines  |  [TEXT/MSET]
  1. (*
  2.  
  3. BaseControl is used for subclassing all controls ( pushButton, checkBox+,
  4. vscrollbar, and hscrollbar) and is similar to the standard Mops control
  5. but with some notable exceptions.  First, we allow any control to be
  6. positioned (but not drawn) and have its value(s) set before it is actually
  7. made new:.  Also, we make controls into selectionn objects so that they
  8. will follow our standard selection protocol.  See the actual control
  9. subclasses for examples of use.
  10.  
  11.  
  12. *)
  13.  
  14. variable    THECTL   \ storage needed by FindControl in method click:
  15.  
  16. \ **** CLICK SUPPORT
  17. \ note that click: is very general and will support scrollbars
  18.  
  19. 0    value    MPOINT
  20.  
  21. \ using thisCtl can often be the best way to add special actions to controls
  22. 0    value    thisCtl
  23.  
  24. : CTLEXEC        \ ( part# ctlHndl -- )  Executes action for control.
  25.      0 swap call GetCRefCon  dup -> thisCtl  exec: **  ;
  26.  
  27. \ CtlProc is the procedure to be executed when a control is being tracked.
  28.  
  29. :proc CTLPROC        \  ( ctlHndl int:part -- )
  30.     word0 swap  ctlExec  ;proc
  31.  
  32.  
  33. \ baseControl is the root class for all controls
  34.  
  35. :class    baseControl super{ nullSelect }
  36.  
  37.     int        PROCID
  38.     int        RESID
  39.     handle    CTLHNDL
  40.     int        theVALUE
  41.     rect+    bounds
  42.     ptr        wind    \ the owning window
  43.  
  44. \ ****** THE FOLLOWING METHODS ARE SAFE TO USE WHEN NOT ALIVE
  45.  
  46. :m alive?:  ( -- b )
  47.     nil?: CTLHNDL not ;m
  48.  
  49. :m RELEASE:
  50.     alive?: self
  51.     IF
  52.         get: ctlHndl  call DisposControl
  53.         clear: ctlHndl
  54.     THEN ;m
  55.     
  56. :m GETRECT:    \ ( -- l t r b )  Stacks bounds rectangle
  57.     get: bounds  \ we always maintain bounds, even when alive
  58.     ;m 
  59.  
  60. :m PUTRESID:    \ ( resID -- )
  61.     put: resID   ;m 
  62.  
  63. :m MOVETO:    { x y -- } \  Moves control to x,y location
  64.     alive?: self
  65.     IF
  66.         get: ctlhndl x y pack call MoveControl
  67.     THEN
  68.     x y moveto: bounds ;m
  69.  
  70. :m MOVE:  { dx dy -- }
  71.     alive?: self
  72.     IF
  73.         dx dy ptr: ctlhndl 8 +  move: rect+    \ message to class
  74.     THEN
  75.     dx dy move: bounds    \ must always maintain bounds
  76.     ;m
  77.  
  78. :m SETSIZE:    { w h -- } \  Sets width, height of control's rect
  79.     alive?: self
  80.     IF
  81.         get: ctlhndl w h pack  call SizeControl
  82.     THEN
  83.     w h setsize: bounds ;m
  84.  
  85. :m SIZE:    \ ( -- w h )
  86.     alive?: self
  87.     IF
  88.         ptr: ctlhndl 8 +  size: rect    \ message to class
  89.     ELSE
  90.         size: bounds
  91.     THEN
  92.     ;m
  93.  
  94. :m SETRECT:    { l t r b -- }
  95.     l t moveto: self
  96.     r l -  b t -  setsize: self ;m 
  97.  
  98. :m PUT:  { theVal -- }    \ Sets the ctl value.
  99.     alive?: self
  100.     IF  get: ctlHndl  theVal makeint  call SetCtlValue
  101.     ELSE theVal  put: theVALUE
  102.     THEN
  103.      ;m 
  104.  
  105. \ if alive, get must always look in the toolbox record because even though
  106. \ we could try to maintain theVALUE ourselves the toolbox can change the
  107. \ control's value via TrackControl
  108. :m GET:        \ ( -- theVal )
  109.     alive?: self
  110.     IF
  111.         word0 get: ctlHndl  call GetCtlValue word0
  112.     ELSE
  113.         get: theValue
  114.     THEN
  115.     ;m
  116.  
  117.  
  118.  
  119. :m draw:    \ Cause the control to be drawn
  120.     alive?: self 0exit
  121.     get: CtlHndl  call Draw1Control ;m 
  122.  
  123. :m HIDE:
  124.     alive?: self 0exit
  125.     get: Ctlhndl  call HideControl  ;m 
  126.  
  127. :m SHOW:
  128.     alive?: self 0exit
  129.     get: Ctlhndl  call ShowControl  ;m 
  130.  
  131. :m HILITE:    \ ( hiliteState -- )  Hilite a part or entire control
  132.     alive?: self 0exit
  133.     get: ctlHndl  swap  makeInt
  134.     call HiliteControl  ;m 
  135.  
  136. :m  deactivate:
  137.     alive?: self 0exit \ 27Feb94 DBH
  138.     -1  hilite: self  ;m 
  139.  
  140. :m  activate:
  141.     alive?: self 0exit \ 27Feb94 DBH
  142.     0  hilite: self  ;m 
  143.  
  144. :m hit?:  ( -- b )
  145.     where: theMouse
  146.     addr: bounds Ptinrect ;m
  147.  
  148.  
  149. :m click: { \ part ^ctl action1 action2 -- }
  150.     where: fEvent  g->l  -> mpoint        \ save mouse loc
  151.     word0  mpoint  get: wind  theCtl  call FindControl
  152.     word0  -> part
  153.     theCtl @ -> ^ctl    \ control handle, should be same as get: ctlHndl
  154.     
  155.     part
  156.     CASE[ konst inThumb ], [ konst inCheckBox ], [ konst inButton ]=>
  157.         0 ->  action1                \ no action while tracking
  158.         ['] ctlExec  -> action2        \ just exec: after mouse up
  159.     DEFAULT=>
  160.         \ but if in scroll up/dn or pageup/pagedn then exec: repeatedly
  161.         drop
  162.         ['] ctlproc -> action1    
  163.         ['] 2drop -> action2    \ do nothing after mouse up
  164.     ]CASE
  165.     
  166.     ^ctl
  167.     IF    word0  ^ctl  mpoint  action1  call TrackControl  word0  ( part#)
  168.         ^ctl  action2 execute
  169.     THEN  ;m
  170.  
  171.  
  172. ;class
  173.  
  174. endload
  175.  
  176. *** EXAMPLE USE
  177.  
  178. See control subclasses, pushButton, checkBox+, vscrollbar, and hscrollbar.
  179.